home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-08-05 | 32.3 KB | 1,014 lines | [TEXT/PJMM] |
- program TExport (input, output);
-
- { Written by Pete Johnson for the Glassell Park BBS }
-
- { Version 2.0 (remember to change VERSION constant!) }
-
- { Date of last revision: June 26, 1991 }
-
- { As of version 1.3, TExport no longer uses LSP calls for files }
- { Version 1.31 is a bug fix release }
- { Version 1.32 adds origin line to locally entered Private NetMail }
- { Version 1.4 adds high message "Look Up" and "Next Launch" }
- { buttons to Config dialog }
-
- { 10/28/89 Now check AREAFIX requests & omit origin lines }
- { Version 1.5 adds WaitNextEvent for MF compatibility }
- { 11/29/89 Version 1.6 handles point ^A lines }
- { 5/6/90 Version 1.7 adds configuration for private }
- { Origin line }
- { 6/14/90 Version 1.8 uses Tabby processed flag instead of }
- { high message number to locate place }
- { 7/15/90 Version 1.9 speeds up processing by setting }
- { processed flag on all messages }
- { 11/15/90 Version 1.91 has Normal setting for regular }
- { processing; otherwise it does a complete scan }
- { 1/8/91 Version 1.92 adds TEXT type option field and Version }
- { info in running dialog. }
- { 2/6/91 Version 1.93 correctly processes 'McNames'. }
- { 5/26/91 Version 1.94 adds WaitNextEvent calls & }
- { SIZE resource. }
- { 6/19/91 Version 1.95 adds ASCII filter & Squelch Twits features }
- { plus export totals for individual sections. }
- { 6/27/91 Version 2.0 cleans up Tabby Log reporting, adds color icons.}
-
- { This program exports messages to Tabby 2.0 using the Generic }
- { Tabby Message Format. }
-
- uses
- Globals, HelloTabby, HostFile;
-
- const
- VERSION = '2.0';
- TabbyFlag = 64;
-
- type
- DateTimeRecord = packed array[1..6] of char;
-
- Header = record
- Status: packed array[1..2] of Byte; { use Status[1] }
- MsgNo: longint;
- Section: packed array[1..2] of Byte; { use Section[1] }
- TimeRcvd: DateTimeRecord;
- MsgFrom: string[31];
- MsgTo: string[31];
- MsgSubject: string[41];
- Destination: packed array[1..68] of char;
- BeginText: longint;
- LengthText: longint;
- ReplyTo: longint;
- TimeSent: DateTimeRecord
- end;
- MessageSectName = array[1..255] of string[25];
- MSectPtr = ^MessageSectName;
-
- var
- MNamePtr: MSectPtr;
- TLogRef, GenericRef, Unknown: integer;
- Echoes, PrivNet: packed array[1..255] of boolean;
- Ms, TempString, SectionString, TheFileName, GenericPath, TheExportFile: STR255;
- Security, Modifier, Restriction, SectionType, MsgCount: integer;
- WhenRcvdString: DateTimeRecord;
- DialogPointer: DialogPtr;
- DeleteFlag, DeCapitalize, PrivOrigin, Normal: boolean;
- TheRect: rect;
- LastHiMsg, logicalEOF, CharsToSend: longint;
-
- {----------------------------------------------------------------- }
-
- function Wr (FileRefNum: integer; TheMessage: string): OSErr;
-
- { Function writes string to text file, returns error code }
-
- var
- TheLength: longint;
-
- begin
- TheLength := length(TheMessage);
- Wr := FSWrite(FileRefNum, TheLength, Pointer(ord(@TheMessage) + 1));
- end;
-
- {----------------------------------------------------------------- }
-
- function WrLn (FileRefNum: integer; TheMessage: string): OSErr;
-
- begin
- WrLn := Wr(FileRefNum, concat(TheMessage, ENDLINE))
- end;
-
- {----------------------------------------------------------------- }
-
- procedure DeCap (var TheName: str255);
-
- var
- NameCount: integer;
-
- procedure HandleMcName (var McN: str255); {Adjusts caps in names such as McNamara}
-
- var
- i: integer;
-
- begin
- if (length(McN) > 2) then
- for i := 3 to length(McN) do
- if ((McN[i - 1] = 'c') & (McN[i - 2] = 'M') & (McN[i] in ['a'..'z'])) & ((i = 3) | (McN[i - 3] = ' ')) then
- McN[i] := chr(ord(McN[i]) - 32);
- end;
-
- begin
- UprString(TheName, false);
- for NameCount := 2 to length(TheName) do { Convert name to caps & lower case }
- if (TheName[NameCount]) in ['A'..'Z'] then
- if (TheName[NameCount - 1] in ['A'..'Z', 'a'..'z']) then
- TheName[NameCount] := chr(ord(TheName[NameCount]) + 32);
-
- HandleMcName(TheName)
- end;
-
- {----------------------------------------------------------------- }
-
- procedure FilterToASCII (var MsgTxtString: str255);
-
- var
- charCount: integer;
-
- begin
- for charCount := 1 to length(MsgTxtString) do
- case MsgTxtString[charCount] of
- '’', '‘':
- MsgTxtString[charCount] := '''';
- '“', '”':
- MsgTxtString[charCount] := '"';
- '—', '…':
- MsgTxtString[charCount] := '-';
- '•':
- MsgTxtString[charCount] := '*';
- '™':
- MsgTxtString[charCount] := 't';
- '©':
- MsgTxtString[charCount] := 'c';
- '®':
- MsgTxtString[charCount] := 'r';
- 'ü':
- MsgTxtString[charCount] := 'u';
- 'é':
- MsgTxtString[charCount] := 'e';
- 'è':
- MsgTxtString[charCount] := 'e';
- otherwise
- if ord(MsgTxtString[charCount]) > 127 then
- MsgTxtString[charCount] := '.'
- end
- end;
-
- {----------------------------------------------------------------- }
-
- function Int2Char (Number: integer): char;
-
- { Function changes integer to character. }
-
- begin
- Int2Char := chr(Number + ord('0'));
- end;
-
- { ------------------------------------------------------ }
-
- function TwoDigit (Number: integer): string;
-
- { Function changes two-digit number to a two-character string. }
-
- begin
- TwoDigit := concat(Int2Char(Number div 10), Int2Char(Number mod 10));
- end;
-
- { ------------------------------------------------------ }
-
- procedure TimeStamp;
-
- var
- Today: DateTimeRec;
- ASCIIHour: string;
-
- begin
- GetTime(Today);
-
- { The TwoDigit function in the following section turns a two-digit integer }
- { into a two-character string. If there are fewer than two digits, the string }
- { contains a leading '0'. }
-
- ASCIIHour := TwoDigit(Today.Hour); { This bit of nonsense is to get the Tabby Log output }
- if length(ASCIIHour) > 1 then { to match a Tabby convention: single-digit hours do }
- if (copy(ASCIIHour, 1, 1) = '0') then { not have leading zeroes, even though all other single }
- ASCIIHour := copy(ASCIIHour, 2, 1); { digit numbers do. }
-
- DateString := concat(TwoDigit(Today.Month), '/', TwoDigit(Today.Day), '/', TwoDigit(Today.Year - 1900));
- TimeString := concat(ASCIIHour, ':', TwoDigit(Today.Minute), ':', TwoDigit(Today.Second));
- DateString := concat(DateString, ' ', TimeString, ' ')
- end;
-
- { ------------------------------------------------------ }
-
- function MakeTime (Index: integer; Separator: char): string;
-
- { Function changes three chars of DateTimeRecord to formatted time or date string }
-
- var
- MakeTimeString, LocalTemp: STR255;
-
- begin
- LocalTemp := '';
- NumToString(ord(WhenRcvdString[Index + 1]), LocalTemp);
- if length(LocalTemp) = 1 then
- LocalTemp := concat('0', LocalTemp);
- MakeTimeString := concat(LocalTemp, Separator);
- NumToString(ord(WhenRcvdString[Index + 2]), LocalTemp);
- if length(LocalTemp) = 1 then
- LocalTemp := concat('0', LocalTemp);
- MakeTimeString := concat(MakeTimeString, LocalTemp, Separator);
- NumToString(ord(WhenRcvdString[Index + 3]), LocalTemp);
- if length(LocalTemp) = 1 then
- LocalTemp := concat('0', LocalTemp);
- MakeTime := concat(MakeTimeString, LocalTemp)
- end;
-
- {----------------------------------------------------------------- }
-
- function Make2Digits (ConvertFrom: string): integer;
-
- { Converts two-character string into an ascii value }
-
- var
- Num1, Num2: integer;
-
- begin
- Num1 := ord(ConvertFrom[1]) - ord('0');
- Num2 := ord(ConvertFrom[2]) - ord('0');
- Make2Digits := Num2 + (Num1 * 10)
- end;
-
- { ------------------------------------------------------ }
-
- function GetWidth (number: integer): integer;
-
- begin
- if number > 999 then
- GetWidth := 4
- else if number > 99 then
- GetWidth := 3
- else if number > 9 then
- GetWidth := 2
- else
- GetWidth := 1
- end;
-
- { ------------------------------------------------------ }
-
- procedure TReadMESSAGES;
-
- { Procedure reads the MESSAGES file }
-
- var
- MSCount, MSGRefNum: integer;
- MSChar, OneChar: char;
- SectionName, MsgString: STR255;
- CharsToSend: longint;
- MsgByte: Byte;
-
- begin
- MNamePtr := MSectPtr(NewPtr(SizeOf(MessageSectName)));
- MsgPath := '';
- CharsToSend := 255;
- Err := FSOpen(MESSAGESPath, vRefNum, MSGRefNum);
- Err := FSRead(MSGRefNum, CharsToSend, @MsgString);
- MsgPath := concat(MsgString, ':');
-
- CharsToSend := 4;
- Err := SetFPos(MSGRefNum, fsFromStart, 50);
- Err := FSRead(MSGRefNum, CharsToSend, @LowMsg);
- Err := FSRead(MSGRefNum, CharsToSend, @HiMsg);
- Err := FSRead(MSGRefNum, CharsToSend, @MSGTXTLength);
-
- Unknown := 255;
- for MSCount := 1 to 254 do
- begin
- if Unknown = 255 then
- begin
- if MultiFinder & ((MSCount mod 25) = 0) then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := SetFPos(MSGRefNum, fsFromStart, (62 + (MSCount - 1) * 36));
- CharsToSend := 255;
- Err := FSRead(MSGRefNum, CharsToSend, @MsgString);
- MNamePtr^[MSCount] := MsgString;
- SectionName := MsgString;
- UprString(SectionName, false);
- if SectionName = 'UNKNOWN' then
- Unknown := MSCount;
- end; { if Unknown = 255 }
-
- Err := SetFPos(MSGRefNum, fsFromStart, (97 + (MSCount - 1) * 36));
- CharsToSend := 1;
- Err := FSRead(MSGRefNum, CharsToSend, @MsgByte);
-
- MsgByte := MsgByte div 256;
-
- Echoes[MSCount] := false;
- PrivNet[MSCount] := false;
-
- case MsgByte of
-
- 4:
- Echoes[MSCount] := true;
-
- 3:
- PrivNet[MSCount] := true;
-
- otherwise
- ;
-
- end; { case statement }
-
- end; { for MSCount := 1 to 255 do }
-
- Err := FSClose(MSGRefNum);
-
- end;
-
- { ------------------------------------------------------ }
-
- procedure ProcessMSGHDR;
-
- { Procedure processes MSGHDR file and MSGTXT file }
-
- const
- MaxBadNames = 100;
-
- var
- ThisHeader: Header;
- FlagCount, Count1, Count2, Count3, TextLineLength, DestCount, DestLimit, TConfigRef, StringEnd: integer;
- MHdrRef, MTextRef, AreaRef, Counter, PeriodMark: integer;
- HeaderEnd, Position, MSGTXTPos, PlaceMark, Index, HeaderSize: longint;
- TheDestination, ReplyMark, MsgTxtString, OriginLine, LocationLine, PointID: STR255;
- Adjustment: real;
- TextLine: packed array[1..255] of char;
- BadNames: array[1..MaxBadNames] of string[15];
- ThisPub, ThisPriv, Marker, Range, GenExpRef: integer;
-
- procedure FindMHPosition;
-
- var
- HiBound, LoBound: longint;
-
- { Procedure finds correct position in MSGHDR file }
-
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- HiBound := (HeaderEnd div sizeOf(ThisHeader)) - 1; { ...mark start of last record }
- Range := HiBound;
- LoBound := 0;
- if Normal then {normal operation looks for last message processed }
- begin
- repeat
- Position := (LoBound + HiBound) div 2;
- Err := SetFPos(MHdrRef, fsFromStart, Position * HeaderSize);
- Err := FSRead(MHdrRef, HeaderSize, @ThisHeader);
- if (BitAnd(TabbyFlag, ThisHeader.Status[1]) = TabbyFlag) then {processed for Tabby}
- LoBound := succ(Position)
- else
- HiBound := pred(Position)
- until (LoBound >= HiBound) | (Err <> NoErr);
- while (Position > 1) & (BitAnd(TabbyFlag, ThisHeader.Status[1]) <> TabbyFlag) & (Err = NoErr) do
- begin
- Position := pred(Position);
- Err := SetFPos(MHdrRef, fsFromStart, Position * HeaderSize);
- Err := FSRead(MHdrRef, HeaderSize, @ThisHeader);
- end
- end
- else
- Position := 0; {if not normal, begin at the start}
- Err := SetFPos(MHdrRef, fsFromStart, Position * HeaderSize);
- Range := Range - Position;
- if Range < 1 then
- Range := 1;
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- end; { procedure FindMHPosition }
-
- var
- BadNameFile, HowManyBadNames, ArrayCount: integer;
- goodUser, goodExport: boolean;
- firstName, lastName: str255;
- ThisSection, ThisStatus: Byte;
- Flag: packed array[1..3] of char;
- ExportArray: array[1..255] of integer;
-
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Marker := 0;
- OriginLine := '';
- for ArrayCount := 1 to 255 do
- ExportArray[ArrayCount] := 0;
-
- for Counter := 1 to MaxBadNames do
- BadNames[Counter] := '';
- Err := FSOpen(concat(gDefaultPath, 'Bad User Names'), vRefNum, BadNameFile);
- Counter := 1;
- while (Err = NoErr) & (Counter < MaxBadNames + 1) do
- begin
- Err := ReadALine(BadNameFile, BadNames[Counter]);
- if BadNames[Counter] = '' then
- leave;
- Counter := succ(Counter);
- end;
- HowManyBadNames := Counter - 1;
- Err := FSClose(BadNameFile);
-
- TheExportFile := concat(GenericPath, 'Generic Export');
- MakeTextFile(TheExportFile);
- Err := FSOpen(TheExportFile, vRefNum, GenExpRef);
- Err := SetFPos(GenExpRef, fsFromLEOF, 0); { Set file position to logical end of file }
-
- TheFileName := concat(MsgPath, 'MSGHDR');
- Err := FSOpen(concat(MsgPath, 'MSGHDR'), vRefNum, MHdrRef);
- if Err = noErr then
- begin
- HeaderSize := sizeOf(ThisHeader);
- Err := GetEOF(MHdrRef, HeaderEnd);
- FindMHPosition;
- Err := GetFPos(MHdrRef, Position); { Get current file position }
- Range := (HeaderEnd - Position) div sizeOf(ThisHeader);
- Adjustment := Range / 100;
- Err := FSOpen(concat(MsgPath, 'MSGTXT'), vRefNum, MTextRef);
- if Err = noErr then
- begin
- while (Position < HeaderEnd) do
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- goodUser := true;
- goodExport := false;
- Marker := Marker + 1;
- TheRect.right := trunc((Marker / Adjustment) + 28);
- if TheRect.right > 128 then
- TheRect.right := 128;
- PaintRect(TheRect);
- Err := FSRead(MHdrRef, HeaderSize, @ThisHeader);
- with ThisHeader do
- begin
- ThisStatus := Status[1]; { use 'good' byte }
- ThisSection := Section[1]; { use 'good' byte }
- if (BitAnd(32, ThisStatus) = 32) then { Local origin }
- if ((Echoes[ThisSection]) | PrivNet[ThisSection]) then { Net pub/priv }
- if (BitAnd(TabbyFlag, ThisStatus) = 0) then { Not yet to Tabby }
- if (BitAnd(1, ThisStatus) = 0) then { Not deleted }
- if (ThisSection in [1..255]) then { Valid section? }
- goodExport := true;
-
- if goodExport & SilenceTwits then
- begin
- firstName := copy(MsgFrom, 1, pos(' ', MsgFrom) - 1);
- lastName := copy(MsgFrom, pos(' ', MsgFrom) + 1, 255);
- for Counter := 1 to HowManyBadNames do
- if EqualString(firstName, BadNames[Counter], false, false) | EqualString(lastName, BadNames[Counter], false, false) then
- begin
- goodUser := false;
- Status[1] := BitOr(1, Status[1]); { Set Delete Bit }
- Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), vRefNum, TLogRef);
- Err := SetFPos(TLogRef, fsFromLEOF, 0);
- TimeStamp;
- TempString := concat(DateString, 'TExport - **Deleted** Message from ', MsgFrom);
- Err := WrLn(TLogRef, TempString);
- Err := FSClose(TLogRef);
- leave
- end
- end;
-
- if goodExport & goodUser then
- begin
- MsgCount := succ(MsgCount);
- ExportArray[ThisSection] := succ(ExportArray[ThisSection]);
- Flag[1] := ' ';
- if (Echoes[ThisSection]) then
- Flag[2] := 'E'
- else
- begin
- Flag[2] := 'M';
- if DeleteFlag then
- ThisStatus := BitOr(1, ThisStatus) {Set Delete Bit }
- end;
- Flag[3] := ' ';
- Status[1] := ThisStatus; { Restore 'undefined' byte }
- Err := WrLn(GenExpRef, Flag);
- NumToString(ThisSection, SectionString);
- while (length(SectionString) < 3) do
- SectionString := concat('0', SectionString);
- Err := WrLn(GenExpRef, SectionString);
- WhenRcvdString := TimeRcvd;
- TempString := MakeTime(0, '/');
- Err := WrLn(GenExpRef, TempString);
- TempString := MakeTime(3, ':');
- Err := WrLn(GenExpRef, TempString);
- TheDestination := '';
- PeriodMark := 0;
- if not (Echoes[ThisSection]) then
- begin
- DestLimit := ord(Destination[1]) + 1;
- if DestLimit > 16 then
- DestLimit := 16;
- for DestCount := 2 to DestLimit do
- TheDestination := concat(TheDestination, Destination[DestCount]);
- PeriodMark := pos('.', TheDestination);
- if PeriodMark <> 0 then
- begin
- PointID := copy(TheDestination, PeriodMark + 1, length(TheDestination) - PeriodMark);
- TheDestination := copy(TheDestination, 1, PeriodMark - 1);
- end;
- end;
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := WrLn(GenExpRef, TheDestination);
- TempString := MsgFrom;
- DeCap(TempString);
- Err := WrLn(GenExpRef, TempString);
- TempString := MsgTo;
- DeCap(TempString);
- Err := WrLn(GenExpRef, TempString);
- if (BitAnd(2, ThisStatus) = 2) then { Message is a reply }
- begin
- ReplyMark := copy(MsgSubject, 1, 3); { Grab the first three characters of Subject }
- uprString(ReplyMark, false);
- if (ReplyMark <> 'RE:') then { Subject is not already marked as reply }
- if length(MsgSubject) < 38 then { Subject isn't already too long }
- MsgSubject := concat('Re: ', MsgSubject)
- end;
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := WrLn(GenExpRef, MsgSubject);
- if (PeriodMark <> 0) then { First line of message text will contain ^ATOPT PointNo }
- Err := WrLn(GenExpRef, concat(CTLA, 'TOPT ', PointID));
- Err := SetFPos(MTextRef, fsFromStart, BeginText);
- Count1 := 0;
- while Count1 < LengthText do
- begin
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := GetFPos(MTextRef, MSGTXTPos); { Get current MSGTXT file position }
- if (MSGTXTPos + 255) < MSGTXTLength then
- CharsToSend := 255
- else
- CharsToSend := MSGTXTLength - MSGTXTPos;
- Err := FSRead(MTextRef, CharsToSend, @MsgTxtString);
- Err := SetFPos(MTextRef, fsFromStart, (MSGTXTPos + length(MsgTxtString) + 1));
-
- if (Length(MsgTxtString) < 91) then
- begin
- if ASCIIFilter then
- FilterToASCII(MsgTxtString);
- Err := WrLn(GenExpRef, MsgTxtString);
- end;
- Count1 := Count1 + length(MsgTxtString) + 1;
-
- end; { while Count1 < LengthText }
-
- TempString := MsgTo;
- uprString(TempString, false);
- if PrivNet[ThisSection] & (TempString <> 'AREAFIX') & PrivOrigin then { it' s local netmail & not an AREAFIX req -- add origin line }
- begin
- if (OriginLine = '') then
- begin
- Err := FSOpen(concat(gDefaultPath, 'Tabby:Areas.BBS'), vRefNum, AreaRef);
- Err := GetEOF(AreaRef, Index);
- Err := SetFPos(AreaRef, fsFromStart, 0);
- if Index > 255 then
- Index := 255;
- Err := FSRead(AreaRef, Index, @TextLine);
- Err := FSClose(AreaRef);
- StringEnd := pos(EndLine, TextLine);
- if StringEnd < 1 then
- StringEnd := Index;
- for Counter := 1 to StringEnd - 1 do
- OriginLine := concat(OriginLine, TextLine[Counter]);
-
- LocationLine := ' (';
- Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Config'), vRefNum, TConfigRef);
- Err := GetEOF(TConfigRef, Index);
- Err := SetFPos(TConfigRef, fsFromStart, 0);
- if Index > 255 then
- Index := 255;
- Err := FSRead(TConfigRef, Index, @TextLine);
- Err := FSClose(TConfigRef);
- StringEnd := pos(EndLine, TextLine);
- if StringEnd < 1 then
- StringEnd := Index;
- for Counter := 1 to StringEnd - 1 do
- LocationLine := concat(LocationLine, TextLine[Counter]);
- LocationLine := concat(LocationLine, ')');
- OriginLine := concat(' * Origin: ', OriginLine, LocationLine);
- end; { if OriginLine <> '' }
-
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := WrLn(GenExpRef, ' ');
- Err := WrLn(GenExpRef, '---');
- Err := WrLn(GenExpRef, ' ');
- Err := WrLn(GenExpRef, OriginLine);
- Err := WrLn(GenExpRef, ' ');
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- end; { if PrivNet[ThisSection] & (TempString <> 'AREAFIX') }
- Err := WrLn(GenExpRef, null);
- end; { if (BitAnd(32, ThisStatus) = 32) etc... }
- end; { with ThisHeader do }
- ThisHeader.Status[1] := BitOr(TabbyFlag, ThisHeader.Status[1]); { Set Tabby bit }
- Err := SetFPos(MHdrRef, fsFromMark, -HeaderSize); { Back up to the start of this record }
- Err := FSWrite(MHdrRef, HeaderSize, @ThisHeader); { Write a fresh copy with the Tabby bit set }
- Err := GetFPos(MHdrRef, Position); { Get current file position }
- end; { while (Position < HeaderEnd) }
- TheRect.right := 128;
- PaintRect(TheRect);
- Err := FSClose(GenExpRef);
- Err := FSClose(MHdrRef);
- Err := FSClose(MTextRef);
- if SectionCount then
- begin
- TimeStamp;
- Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), vRefNum, TLogRef);
- Err := SetFPos(TLogRef, fsFromLEOF, 0);
- for ArrayCount := 1 to 255 do
- if ExportArray[ArrayCount] > 0 then
- begin
- if ExportArray[ArrayCount] = 1 then
- Err := WrLn(TLogRef, concat(DateString, 'TExport - ', StringOf(ExportArray[ArrayCount] : GetWidth(MsgCount)), ' Message from ', MNamePtr^[ArrayCount], ' #', StringOf(ArrayCount : 1)))
- else
- Err := WrLn(TLogRef, concat(DateString, 'TExport - ', StringOf(ExportArray[ArrayCount] : GetWidth(MsgCount)), ' Messages from ', MNamePtr^[ArrayCount], ' #', StringOf(ArrayCount : 1)));
- end;
- Err := FSClose(TLogRef);
- end; {if SectionCount}
- end; {no error opening MSGTXT}
- end; {no error opening MSGHDR}
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- if MNamePtr <> nil then
- begin
- DisposPtr(Pointer(MNamePtr));
- MNamePtr := nil
- end
- end;
-
- { ------------------------------------------------------ }
-
- procedure HandleDialog;
-
- var
- theDialog: DialogPtr;
- ItemHit, itemType, whichItem, MsgRefNum: integer;
- itemHandle: Handle;
- dispRect: Rect;
- thisButton: ControlHandle;
- where: point;
- CharsToSend, HiMsgNumber: longint;
- fileReply: SFReply;
- whatToFind: SFTypeList;
- NextLaunch: str255;
-
- begin
- InitCursor;
- theDialog := GetNewDialog(1002, nil, POINTER(-1));
- SetPort(theDialog);
- FrameDItem(theDialog, Ok);
-
- NextLaunch := GetString(500)^^; { Get next launch string from resource }
- getDItem(theDialog, 5, itemType, itemHandle, dispRect);
- SetIText(itemHandle, NextLaunch);
- ;
- getDItem(theDialog, 6, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if DeleteFlag then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- ;
- getDItem(theDialog, 7, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if DeCapitalize then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- ;
- getDItem(theDialog, 8, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if PrivOrigin then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- getDItem(theDialog, 15, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if Normal then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- getDItem(theDialog, 16, itemType, itemHandle, dispRect);
- SetIText(itemHandle, CreatorType);
-
- getDItem(theDialog, 19, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if ASCIIFilter then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- getDItem(theDialog, 20, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if SilenceTwits then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- getDItem(theDialog, 21, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if SectionCount then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
-
- ForeColor(redColor);
- getDItem(theDialog, 3, itemType, itemHandle, dispRect);
- TempString := concat('TExport v ', VERSION);
- SetIText(itemHandle, TempString);
- ForeColor(blackColor);
- ;
- if StillDown then
- repeat
- until not Button;
- repeat
- ModalDialog(nil, ItemHit); {IM I-415}
- ;
- case ItemHit of
- 1: { OK button hit -- save resources }
- begin
- getDItem(theDialog, 5, itemType, itemHandle, dispRect);
- GetIText(itemHandle, NextLaunch);
- RmveResource(GetResource('STR ', 500));
- UpdateResFile(CurResFile);
- AddResource(Handle(NewString(NextLaunch)), 'STR ', 500, 'Next Launch');
- ;
- TempString := 'NNNNNNN';
- ;
- if DeleteFlag then
- TempString[1] := 'Y';
- ;
- if DeCapitalize then
- TempString[2] := 'Y';
- ;
- if PrivOrigin then
- TempString[3] := 'Y';
- ;
- if Normal then
- TempString[4] := 'Y';
-
- if ASCIIFilter then
- TempString[5] := 'Y';
-
- if SilenceTwits then
- TempString[6] := 'Y';
-
- if SectionCount then
- TempString[7] := 'Y';
-
- RmveResource(GetResource('STR ', 501));
- UpdateResFile(CurResFile);
- AddResource(Handle(NewString(TempString)), 'STR ', 501, 'Defaults');
- ;
- RmveResource(GetResource('STR ', 503));
- UpdateResFile(CurResFile);
- AddResource(Handle(NewString(CreatorType)), 'STR ', 503, 'TEXT Creator');
- ;
- end;
-
- 2:
- ; { Cancel button hit—do nothing }
-
- 6:
- begin { Delete Sent Netmail switch }
- DeleteFlag := not (DeleteFlag);
- getDItem(theDialog, 6, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if DeleteFlag then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 7:
- begin { DeCapitalize switch }
- DeCapitalize := not (DeCapitalize);
- getDItem(theDialog, 7, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if DeCapitalize then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 4:
- begin { Look Up Next Launch button }
- where.h := 60;
- where.v := 80;
- whatToFind[0] := 'APPL';
- ParamText('next application to launch', '', '', '');
- SFGetFile(where, '', nil, 1, whatToFind, nil, fileReply);
- if fileReply.good then
- begin
- getDItem(theDialog, 5, itemType, itemHandle, dispRect);
- SetIText(itemHandle, fileReply.fName);
- end;
- FrameDItem(theDialog, Ok);
- end;
-
- 8:
- begin { Private Origin Line switch }
- PrivOrigin := not (PrivOrigin);
- getDItem(theDialog, 8, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if PrivOrigin then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 15:
- begin { Normal Operation switch }
- Normal := not (Normal);
- getDItem(theDialog, 15, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if Normal then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 19:
- begin { ASCII Filter switch }
- ASCIIFilter := not (ASCIIFilter);
- getDItem(theDialog, 19, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if ASCIIFilter then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 20:
- begin { SilenceTwits switch }
- SilenceTwits := not (SilenceTwits);
- getDItem(theDialog, 20, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if SilenceTwits then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 21:
- begin { SectionCount switch }
- SectionCount := not SectionCount;
- getDItem(theDialog, 21, itemType, itemHandle, dispRect);
- thisButton := ControlHandle(itemHandle);
- if SectionCount then
- SetCtlValue(thisButton, 1)
- else
- SetCtlValue(thisButton, 0);
- end;
-
- 16: { TEXT Creator field }
- begin
- getDItem(theDialog, ItemHit, itemType, itemHandle, dispRect);
- GetIText(itemHandle, CreatorType);
- end;
-
- otherwise
- ; { do nothing }
-
- end;
- until (ItemHit = 1) or (ItemHit = 2);
- DisposDialog(theDialog)
- end;
-
- { ------------------------------------------------------ }
-
- var
- itemType: integer;
- itemHandle: handle;
- dispRect: rect;
-
- begin
- TempString := GetString(501)^^;
- uprString(TempString, false);
-
- if (TempString[1] = 'Y') then
- DeleteFlag := true
- else
- DeleteFlag := false;
-
- if (TempString[2] = 'Y') then
- DeCapitalize := true
- else
- DeCapitalize := false;
-
- if (TempString[3] = 'Y') then
- PrivOrigin := true
- else
- PrivOrigin := false;
-
- if (TempString[4] = 'Y') then
- Normal := true
- else
- Normal := false;
-
- if (TempString[5] = 'Y') then
- ASCIIFilter := true
- else
- ASCIIFilter := false;
-
- if (TempString[6] = 'Y') then
- SilenceTwits := true
- else
- SilenceTwits := false;
-
- if (TempString[7] = 'Y') then
- SectionCount := true
- else
- SectionCount := false;
-
- CreatorType := GetString(503)^^;
- while length(CreatorType) < 4 do
- CreatorType := concat(CreatorType, ' ');
- while length(CreatorType) > 4 do
- CreatorType := copy(CreatorType, 1, length(CreatorType) - 1);
-
- if Button then
- HandleDialog { If user is holding down the mouse button, reconfigure and end }
- else
- begin
- HelloTabby; { find out what's next on the launchpad }
- MsgCount := 0;
- Err := GetVol(@gVolName, vRefNum); { Get volume ref # for default volume }
- DialogPointer := GetNewDialog(1001, nil, POINTER(-1));
- DrawDialog(DialogPointer);
- SetPort(DialogPointer);
- ForeColor(redColor);
- TextFont(Geneva);
- TextSize(9);
- getDItem(DialogPointer, 2, itemType, itemHandle, dispRect);
- SetIText(itemHandle, VERSION);
- SetRect(TheRect, 28, 49, 128, 54);
- FrameRect(TheRect);
- TimeStamp;
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
-
- Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), vRefNum, TLogRef);
- Err := SetFPos(TLogRef, fsFromLEOF, 0);
- TempString := concat(DateString, 'TExport - Program Starting (v ', VERSION, ')');
- Err := WrLn(TLogRef, TempString);
- Err := FSClose(TLogRef);
-
- if MultiFinder then
- IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
- Err := FSOpen(concat(gDefaultPath, 'Generic'), vRefNum, GenericRef);
- if Err = NoErr then
- Err := GetEOF(GenericRef, logicalEOF);
- if (logicalEOF > 0) & (Err = NoErr) then
- begin
- Err := ReadALine(GenericRef, GenericPath);
- Err := FSClose(GenericRef);
- if ReadConfig then
- begin
- TReadMESSAGES;
- ProcessMSGHDR
- end
- end;
-
- TimeStamp;
- Err := FSOpen(concat(gDefaultPath, 'Tabby:Tabby Log'), vRefNum, TLogRef);
- Err := SetFPos(TLogRef, fsFromLEOF, 0);
- if MsgCount > 0 then
- begin
- if MsgCount = 1 then
- TempString := concat(DateString, 'TExport - ', StringOf(MsgCount : GetWidth(MsgCount)), ' Message Total')
- else
- TempString := concat(DateString, 'TExport - ', StringOf(MsgCount : GetWidth(MsgCount)), ' Messages Total');
- Err := WrLn(TLogRef, TempString);
- end;
- Err := WrLn(TLogRef, concat(DateString, 'TExport - Program Ending'));
- Err := FSClose(TLogRef);
-
- DisposDialog(DialogPointer);
-
- if NextLaunch <> '' then
- LaunchNextAppl
- end
- end.